perm filename CRE[CRE,BGB]1 blob
sn#021785 filedate 1973-01-28 generic text, type T, neo UTF8
00100 TITLE CRE - CART'S EYE THREE - DECEMBER 1972.
00200
00300 ;CONTROL FLAGS.
00400 INTERN FLGSIX,FLGARC,FLGBK
00500
00600 FLGKRK:-1 ;ENABLE KRAKAUER TREE.
00700 FLGSIX:-1 ;SIX BIT TELEVISON.
00800 FLGARC:-1 ;ENABLE MAKE ARC SMOOTHING.
00900
01000 FLGBK:-1 ;ENABLE BABY KILLER.
01100 VCUT:-14 ;VECTOR DISPLAY CONTRAST THRESHOLD.
01200 FLGWED:0 ;DISPLAY WINGED EDGED IMAGE.
01300
01400 FLGBGB:0 ;RUNNING UNDER A BGB PPPN.
01500 FLGRAR:1 ;DISPLAY RECIPROCAL ARC RADIALS.
01600 ;-1 BOTH, 0 VIC, +1 ARCS.
01700 FLGKINK:0 ;DISPLAY KINKS.
01800 FLGU:-1 ;KILVIC ENABLE.
01900
02000 ;ARC WIDTH PROPORTIONAL TO CONTRAST TABLE FOR MKARCS.
02100 ARCWID:
02200 FOR I←0,3{2.0↔}
02300 FOR I←4,5{1.5↔}
02400 FOR I←6,12{1.25↔}
02500 FOR I←13,17{1.0↔}
02600 FOR I←20,37{1.0↔}
02700 FOR I←40,77{0.7↔}
02800 0
02900
03000
03100 ;POINTERS TO SKY ROWS - COLUMN ACCUMULATOR-3.
03200 SKY: FOR I←0,=216{
03300 1B18+=289*I(3)}
03400
03500 SUBR(LOCKIN)
03600 LAC[XWD 400017,.+3]↔CALLI 400003↔POP0J↔HALT
03700 DEFINE UNLOCK{043000636367}
00100 ;CAREYE STANDARD TV FILE IS =10496 WORDS LONG, 24400 OCTAL.
00200 ;=10 WORD HEADER, =216 ROWS OF =288 COLUMNS OF 6 BITS PER PIXEL.
00300 ;=118 WORD TRAILER.
00400
00500 HI ←← 400000
00600 $←400000
00700
00800 PAC ← HI ↔ HI ←← HI + =1728 ;PICTURE ACCUMULATOR.
00900 VSEG← HI ↔ HI ←← HI + =1729 ;VERTICAL SEGMENTS.
01000 HSEG← HI ↔ HI ←← HI + =1736 ;HORIZONTAL SEGMENTS.
01100
01200 HI ←← HI + =86 ;NEGATIVE ROWS.
01300 HEADER←HI ↔ HI ←← HI + =10
01400 TVBUF ←HI ↔ HI ←← HI + =10368 ;TV BUFFER 6 BITS PER PIXEL.
01500 HI ←← HI + =54 ;FREE SPACE.
01600 HISTO ←HI ↔ HI ←← HI + =64 ;HISTOGRAM.
01700 FTVSIX←HI ↔ HI ←← HI + 1 ;FLAG TV SIX BIT.
01800 FTVHIS←HI ↔ HI ←← HI + 1 ;FLAG TV HISTOGRAM PRESENT.
01900
02000
02100 ;POINTERS TO TV SEGMENT.
02200 TV: 0
02300 POINT 6,-1,29 ;COLUMN -2.
02400 POINT 6,-1,35 ;COLUMN -1.
02500 COLPTR: FOR I←0,=48{
02600 I+<POINT 6,0,05>↔I+<POINT 6,0,11>↔I+<POINT 6,0,17>
02700 I+<POINT 6,0,23>↔I+<POINT 6,0,29>↔I+<POINT 6,0,35>}
02800 ROWPTR: FOR I←0,=216{
02900 I*=48+TVBUF}
03000 ISAVED: 0
03100
03200 TVSEG: 0
03300 SKYSEG: 0
03400 O(ATTSEG,CALLI 400016)
03500 O(DETSEG,CALLI 400017)
03600 O(SEGNUM,CALLI 400021)
03700 O(CORE2, CALLI 400015)
00100 ;INITIALIZATION---------------------------------------------------
00200 OPDEF PPIOT[702B8]
00300 PDL: BLOCK 100
00400
00500 ;START ADDRESS
00600 SA: LAC 17,[IOWD 100,PDL]
00700 CALL(MORCOR)
00800
00900 ;RE-ENTRY ADDRESS.
01000 REE: LACI .↔DAC 124
01100 PPIOT 2,-=250↔PPIOT 3,3003
01200 MOVEI 20↔CRLF↔SOJG .-1
01300 SETZ↔CALLI 24↔CDR
01400 CAIN'BGB'↔SETOM FLGBGB
01500 LAC 17,[IOWD 100,PDL]
01600 CALL(CROP)
01700 CALL(DPYIMG)
01800 PUSHJ TTY
01900 CALLI 12
02000 ;6/12/72----------------------------------------------------------
02100 ;TELETYPE COMMAND STATE.
02200 DECLARE{CTRL,META,CHR}
00100 SUBR(TTY)---------------------------------------------------------
00200 BEGIN TTY;CAREYE TELETYPE COMMAND JUMP TABLE -BGB- NOVEMBER 1972.
00300 L0: CRLF
00400 L1: OUTCHR["*"]
00500 INCHRW
00600 SETZM CTRL↔TRZE 200↔SETOM CTRL
00700 SETZM META↔TRZE 400↔SETOM META
00800 CAIN 0,15↔GO L1+1
00900 CAIN 0,12↔GO L1
01000 DAC 0,CHR
01100
01200 ;TEST FOR LETTER COMMAND.
01300 LAC 1,0↔ANDI 1,37
01400 CAIGE 0,"A"↔GO .+3
01500 CAIG 0,"Z"↔GO L3
01600 CAIGE 0,"a"↔GO .+3
01700 CAIG 0,"z"↔GO L3
01800
01900 ;WINDOW MOVING COMMANDS.
02000 CAIN 0," "↔GO L2
02100 CAIN 0,":"↔GO[LAC SX↔FAD DEL↔DAC SX↔GO L2]
02200 CAIN 0,";"↔GO[LAC SX↔FSB DEL↔DAC SX↔GO L2]
02300 CAIN 0,")"↔GO[LAC SY↔FAD DEL↔DAC SY↔GO L2]
02400 CAIN 0,"("↔GO[LAC SY↔FSB DEL↔DAC SY↔GO L2]
02500 CAIN 0,"/"↔GO[LAC DEL↔FSC -1↔DAC DEL↔GO L2]
02600 CAIN 0,"\"↔GO[LAC DEL↔FSC 1↔DAC DEL↔GO L2]
02700 CAIN 0,"*"↔GO[LAC MAG↔FMP[1.5]↔DAC MAG↔GO L2]
02800 CAIN 0,"-"↔GO[LAC MAG↔FDV[1.5]↔DAC MAG↔GO L2]
02900
03000 ;QBLK CHANGING COMMANDS.
03100 CAIN 0,"!"↔GO[SETZ 1,↔GO L2B+1]
03200 CAIN 0,"+"↔GO[LAC 1,FILM↔GO L2B+1]
03300 CAIN 0,","↔GO[SKIPE 1,QBLK↔CW 1,1↔GO L2B]
03400 CAIN 0,"."↔GO[SKIPE 1,QBLK↔CCW 1,1↔GO L2B]
03500 CAIN 0,"↓"↔GO[SKIPE 1,QBLK↔ENDO 1,1↔GO L2B]
03600 CAIN 0,"↑"↔GO[SKIPE 1,QBLK↔EXO 1,1↔GO L2B]
03700 CAIN 0,"↔"↔GO[SKIPE 1,QBLK↔ARC 1,1↔GO L2B]
03800 CAIN 0,"≥"↔GO[SKIPE 1,QBLK↔PED 1,1↔GO L2B]
03900 CAIN 0,"≤"↔GO[SKIPE 1,QBLK↔NED 1,1↔GO L2B]
04000 CAIN 0,"<"↔GO[SKIPE 1,QBLK↔NCCW 1,1↔GO L2B]
04100 CAIN 0,">"↔GO[SKIPE 1,QBLK↔SON 1,1↔GO L2B]
04200 CAIN 0,"→"↔GO[SKIPE 1,QBLK↔PGON 1,1↔GO L2B]
04300 CAIN 0,"←"↔GO[SKIPE 1,QBLK↔NGON 1,1↔GO L2B]
04400 CAIN 0,"6"↔GO[SETOM FLGSIX↔SETOM FTVSIX↔GO L1]
04500 CAIN 0,"4"↔GO[SETZM FLGSIX↔SETZM FTVSIX↔GO L1]
04600 GO L0
04700
04800 L2: CALL(CROP)↔CALL(DPYIMG)↔GO L1+1
04900 L2B: SKIPE 1↔DAC 1,QBLK↔CALL(DPYBLK)↔GO L1+1
00100
00200 L3: PUSHJ P,@L4(1)↔GO L1
00300
00400 L4: NOP ;null.
00500 FLGA. ;"A" ARC MAKE FLAG.
00600 CART ;"B" DRIVE BACKWARDS.
00700 MAKCUT ;"C" MAKE THRESHOLD CUT.
00800 FLGB. ;"D" DELETE BABY POLYGONS.
00900 FLGE. ;"E"
01000 CART ;"F" DRIVE FORWARDS.
01100 NOP ;"G"
01200 DPYHIS ;"H" HISTOGRAM, "αH" ,"βH" BI-MODAL CUT.
01300 CREIN ;"I" INPUT.
01400 BIMOD ;"J" TWO CUTS AT 3% FROM ENDS.
01500 FLGK. ;"K" KRAKAUER FLAG.
01600 CART ;"L" TURN LEFT. "αL" PAN CAMERA LEFT.
01700 MKGLYPH ;"M" MAKE GLYPH IMAGE.
01800 NEXIMG ;"N" IMAGE RETREAT.
01900 CREOUT ;"O" OUTPUT.
02000 PLOTO ;"P" PLOT OUTPUT FILE.
02100 MKCUTS ;"Q" EQUI-SPACED CUTS.
02200 CART ;"R" TURN RIGHT. "αR" PAN CAMERA RIGHT.
02300 CAMERA ;"S" SELECT CAMERA, "αS" BCLIP, "βS" TCLIP.
02400 TVCAMI ;"T" TAKE TELEVISON PICTURE. "αT" SIXBIT.
02500 FLGU. ;"U"
02600 CART ;"V" CART DIAGONOSTIC COMMAND MODE.
02700 AWIDTH ;"W"
02800 TVXGP ;"X" XEROX OUTPUT.
02900 FLGR. ;"Y" DISPLAY RECIPROCAL ARC RADIALS.
03000 KILLER ;"Z" ZERO DATA BUFFERS.
03100
03200 NOP: CRLF
03300 POP0J
03400 FLGA.: SETCMM FLGARC↔CRLF↔POP0J
03500 FLGB.: SETCMM FLGBK ↔CRLF↔POP0J
03600 FLGE.: SETCMM FLGWED↔CALL(DPYIMG)↔CRLF↔POP0J
03700 FLGK.: SETCMM FLGKRK↔CRLF↔POP0J
03800 FLGU.: SETCMM FLGU↔CRLF↔POP0J
03900 FLGR.: SETZM FLGWED
04000 LAC CTRL↔AND META
04100 JUMPN[SETOM FLGKINK↔GO .+8]↔SETZM FLGKINK
04200 LACI 1↔DAC FLGRAR
04300 SKIPE CTRL↔SETOM FLGRAR
04400 SKIPE META↔SETZM FLGRAR
04500 CALL(DPYIMG)↔CRLF↔POP0J
04600 LIT
04700 BEND;12/8/72------------------------------------------------------
00100 SUBR(SEGTV)-------------------------------------------------------
00200 ;GET THE OLD TVSEG.
00300 SETZ↔SEGNUM
00400 SKIPE 1,TVSEG
00500 GO[ CAMN 0,1↔POP0J↔SKIPE↔DETSEG
00600 ATTSEG 1,↔GO[FATAL(TVSEG ATTACH FAILURE.)]↔POP0J]
00700 SKIPE↔DETSEG
00800 ;MAKE A NEW TVSEG.
00900 LACI HI
01000 CALLI 400015↔GO[FATAL(AIN'T NO CORE UP YONDER.)]
01100 LAC[SIXBIT/TVSEG/]↔CALLI 400036↔JFCL
01200 SETZ↔SEGNUM↔DAC TVSEG
01300 LAC[XWD $,$+1]↔SETZM $↔BLT HI-1
01400 LAC[XWD HEAD,HEADER]↔BLT HEADER+9
01500 POP0J
01600 ;OLDE TEN WORD TV PICTURE HEADER.
01700 HEAD: 7↔0↔6↔=288↔=48↔=20↔=235↔=28↔=315↔=10368
01800 ;16/12/72---------------------------------------------------------
00100 SUBR(KILLER)------------------------------------------------------
00200 BEGIN KILLER
00300 SKIPE CTRL↔GO L
00400 SETZM QBLK
00500 LAC OLD44↔CALLI 11↔JFCL↔SETZM OLD44
00600 SETZM AVAIL↔SETZM BLKCNT↔SETZM FILM
00700 CALL(MORCOR)
00800 L: SETZM SX↔SETZM SY↔LAC[32.0]↔DAC DEL↔LAC[3.4]↔DAC MAG
00900 CALL(CROP)↔CALL(DPYIMG)
01000 CRLF↔POP0J
01100 BEND;12/31/72-----------------------------------------------------
01200
01300 SUBR(NEXIMG)------------------------------------------------------
01400 BEGIN NEXIMG;NEXT IMAGE - BGB - 11 DEC 72.
01500 SKIPA
01600 SETOM CTRL
01700 LAC 1,FILM
01800 SON 2,1
01900 CDR 3,(2)↔SKIPE CTRL↔CAR 3,(2)
02000 SON. 3,1
02100 CALL(DPYIMG)
02200 SKIPE META↔GO[INCHRS↔GO NEXIMG↔GO .+1]
02300 CRLF
02400 POP0J
02500 BEND;12/11/72-----------------------------------------------------
00100 SUBR(MAKCUT)------------------------------------------------------
00200 BEGIN MAKCUT; MAKE CUTS "C" COMMAND.
00300
00400 ;CONTRAST DISPLAY CUT OFF COMMANDS.
00500 SKIPE META↔GO[MOVNS VCUT↔CALL(DPYIMG)↔POP0J]
00600 SKIPE CTRL↔GO[INCHRW↔ANDI 7↔LSH 3
00700 INCHRW 1↔ANDI 1,7↔IOR 0,1↔DAC VCUT↔CALL(DPYIMG)↔POP0J]
00800
00900 ;MAKE CUT COMMAND BEGINS HERE.
01000 SETZM QQ2↔SETZM QQ3
01100 L1: SETZ 1,↔INCHWL
01200 CAIN 15↔GO[CALL(L3)↔GO L2]
01300 CAIL 0,"0"↔CAILE 0,"7"↔GO[CALL(L3)↔GO L1]
01400 IMULI 1,=8↔ANDI 17↔ADD 1,0↔GO L1+1
01500
01600 L2: INCHWL
01700 CALL(CRE,QQ2,QQ3)↔CALL(DPYIMG)↔CALL(SHRINK)
01800 POP0J
01900
02000 DECLARE{QQ2,QQ3}
02100
02200 L3: SKIPN 1↔POP0J
02300 CAIL 1,=64↔POP0J
02400 MOVNS 1↔SETZ 3,
02500 SLACI 2,1B18↔LSHC 2,(1)
02600 IORM 2,QQ2↔IORM 3,QQ3
02700 POP0J
02800
02900 LIT
03000 BEND;1/17/73------------------------------------------------------
03100
00100 SUBR(MKCUTS)------------------------------------------------------
00200 BEGIN MKCUTS; MAKE CUTS Q-COMMAND - BGB - 9 DEC 1972.
00300 SETZ 1,
00400 SKIPE CTRL↔LACI 1,1
00500 SKIPE META↔ADDI 1,2
00600 PUSH P,Q1(1)
00700 PUSH P,Q2(1)
00800 CALL(CRE)
00900 CALL(SHRINK)
01000 CALL(DPYIMG)
01100 POP0J
01200
01300 ;THREE, SEVEN, EIGHT OR FIFTEEN CUTS - EQUALLY SPACED.
01400 Q1: 1B16 +1B32
01500 1B8+1B16+1B24+1B32 ↔ 1B4+1B12+1B20+1B28
01600 1B8+1B16+1B24+1B32 + 1B4+1B12+1B20+1B28
01700 Q2: 1B12
01800 1B4+1B12+1B20 ↔ 1B0+1B8+1B16+1B24
01900 1B4+1B12+1B20 + 1B0+1B8+1B16+1B24
02000 BEND;12/9/72------------------------------------------------------
00100 SUBR(AWIDTH)------------------------------------------------------
00200 BEGIN AWIDTH; SELECT ARC WIDTH - BGB - 16 DEC 1972.
00300 ACCUMULATORS{DEL,XLO,XHI,X1,X2}
00400 TDCA X2,X2↔INCHWL
00500 L1: OUTSTR[ASCIZ/ #/]
00600
00700 INCHRW↔CAIN 15↔GO L1-1
00800 CAIL"0"↔CAILE"7"↔GO L4
00900 ANDI 7↔LSH 3↔DAC 1
01000
01100 INCHRW↔CAIN 15↔GO L1-1
01200 CAIL"0"↔CAILE"7"↔GO L4
01300 ANDI 7↔ADD 1,0↔EXCH 1,X2↔DAC 1,X1
01400
01500 L2: CALL(TYPOUT)
01600 CALL(REALIN)
01700 JUMPLE .+3↔CAMGE[100.0]↔CALL(ALTER)
01800 CAIE 1,12↔GO .+3↔OUTCHR[15]↔AOJA X2,L3
01900 CAIN 1,15↔INCHWL
02000 CAIE 1,175↔GO L1↔CRLF↔SOJA X2,L3
02100 L3: CAILE X2,77↔LACI X2,77
02200 CAIGE X2,00↔LACI X2,00
02300 LAC[ASCIZ/ #00/]
02400 DPB X2,[POINT 3,0,27]↔ROT X2,-3
02500 DPB X2,[POINT 3,0,20]↔ROT X2, 3
02600 OUTSTR↔GO L2
02700 L4: CRLF↔POP0J
02800
02900 TYPOUT: LAC ARCWID(X2)↔FMPR[100.0]↔FIXX
03000 IDIVI 0,=1000
03100 SKIPE↔IORI"0"↔IORI" " ↔DPB 0,[POINT 7,STR,13]
03200 IDIVI 1,=100 ↔IORI 1,"0"↔DPB 1,[POINT 7,STR,20]
03300 IDIVI 2,=10 ↔IORI 2,"0"↔DPB 2,[POINT 7,STR,34]
03400 IORI 3,"0"↔DPB 3,[POINT 7,STR+1,6]
03500 OUTSTR STR↔POP0J
03600 STR: ASCIZ/ 99.99 /
03700
03800 ALTER: DAC ARCWID(X2)
03900 LAC XLO,X1↔LAC XHI,X2↔CAMLE XLO,XHI↔EXCH XLO,XHI
04000 LAC XHI↔SUB XLO↔FLOAT
04100 LAC DEL,ARCWID(XHI)↔FSBR DEL,ARCWID(XLO)↔FDVR DEL,0
04200 LAC ARCWID(XLO)↔AOS XLO
04300 L5: CAML XLO,XHI↔POP0J
04400 FADR DEL↔DAC ARCWID(XLO)↔AOJA XLO,L5
04500
04600 BEND;12/16/72-----------------------------------------------------
00100 SUBR(REALIN)------------------------------------------------------
00200 BEGIN REALIN; INPUT FROM TTY SMALL REAL NUMBER - BGB - 16 DEC 1972.
00300 ;AC-0 INTEGER ACCUMULATION. AC-0 RETURNS REAL NUMBER.
00400 ;AC-1 CHARACTER. AC-1 RETURNS BREAK CHARACTER.
00500 ;AC-2 COUNTER OF DIGITS TO RIGHT OF DECIMAL POINT PLUS ONE.
00600 ;AC-3 MINUS SIGN FLAG.
00700 SETZ↔SETZB 2,3
00800 L1: INCHWL 1
00900 CAIE 1,"-"↔GO .+3↔SETCMM 3↔GO L1
01000 CAIE 1,"."↔GO .+3↔JUMPN 2,L2↔AOJA 2,L1
01100 CAIL 1,"0"↔CAILE 1,"9"↔GO L2
01200 JUMPN 2,[CAILE 2,4↔GO L1↔AOJA 2,.+1]
01300 ANDI 1,17↔IMULI =10↔ADD 1↔GO L1
01400 L2: FLOAT↔SOSLE 2↔FDVR[1.0↔10.0↔100.0↔1000.0↔10000.0](2)
01500 SKIPE 3↔MOVNS↔POP0J
01600 BEND;12/16/72-----------------------------------------------------
00100 SUBR(MKGLYPH)-----------------------------------------------------
00200 BEGIN; MAKE GLYPH IMAGE.
00300
00400 ACCUMULATORS{A2,PG,LVL,IMG}
00500 LAC PG,QBLK
00600 TEST PG,PBIT
00700 POP0J ;AIN'T POLYGON.
00800
00900 ;DETACH QBLK POLYGON FROM ITS LEVEL.
01000
01100 CW 1,PG↔CCW 2,PG↔DAC 2,PGSAV#
01200 CCW. 2,1↔CW. 1,2
01300 CAMN 1,PG↔SETZ 1,
01400 DAD LVL,PG↔SON 0,LVL
01500 CAMN 0,PG↔SON. 1,LVL
01600
01700 ;GET PREVIOUS IMAGE.
01800 LAC 1,FILM↔SON IMG,1↔DAC IMG,SAVIMG#
01900 CW IMG,IMG
02000 SON LVL,IMG
02100 SKIPN CTRL↔GO L1
02200
02300 ;MAKE NEW IMAGE WHEN CALLED FOR "αM".
02400 SETQ(I,{MKIMAG,FILM})
02500 SETQ(LVL,{MKLEVL,I,[-1]})
02600 LAC IMG,I#
02700 SON. LVL,IMG
02800 LAC PG,QBLK
02900
03000 ;PLACE THE POLYGON INTO THE IMAGE.
03100 L1: CALL(RINGIN,PG,LVL)
03200 LAC 1,FILM↔LAC SAVIMG↔SON. 0,1
03300 LAC PGSAV↔DAC QBLK
03400 CALL(DPYIMG)
03500 CRLF
03600 POP0J
03700 BEND;1/28/73------------------------------------------------------